home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / DELPHI32 / COMPNENT / ISAMEXPT / DBF2ISAM.PAS < prev    next >
Pascal/Delphi Source File  |  1996-04-04  |  4KB  |  153 lines
  1. unit Dbf2isam;
  2.  
  3. interface
  4.  
  5. uses WinTypes, WinProcs, Classes, Graphics, Forms, Controls, Buttons,
  6.   StdCtrls, Isamtabl, Gauges, DB, DBTables, ExtCtrls,
  7.   U_DbTool, Grids, DBGrids;
  8.  
  9. type
  10.   DBASEImportProc = Procedure(var DATA; DBTable: TTable; ISTable: TIsamTable);
  11.  
  12.   TImportDlg = class(TForm)
  13.     CancelBtn: TBitBtn;
  14.     Bevel1: TBevel;
  15.     Table1: TTable;
  16.     Gauge1: TGauge;
  17.     IsamTable1: TIsamTable;
  18.     StartBttn: TBitBtn;
  19.     DataSource1: TDataSource;
  20.     DBGrid1: TDBGrid;
  21.     GroupBox1: TGroupBox;
  22.     aktualRadio: TRadioButton;
  23.     appendradio: TRadioButton;
  24.     appendandupdateradio: TRadioButton;
  25.     procedure CancelBtnClick(Sender: TObject);
  26.     procedure FormDestroy(Sender: TObject);
  27.     procedure FormCreate(Sender: TObject);
  28.     procedure FormShow(Sender: TObject);
  29.     procedure StartBttnClick(Sender: TObject);
  30.   private
  31.     { Private declarations }
  32.   public
  33.     FieldGetProc: DBASEImportProc;
  34.     Data,Dup    : Pointer;
  35.   end;
  36.  
  37. var
  38.   ImportDlg: TImportDlg;
  39.  
  40. Procedure DBase2Isam(aParent: TForm;
  41.                      IsamTable: TIsamTable;
  42.                      DBASETableName: String;
  43.                      AliasName: String;
  44.                      FieldGet: DBASEImportProc);
  45.  
  46. implementation
  47.  
  48. Uses SysUtils, UToolDll, Filer;
  49.  
  50. {$R *.DFM}
  51.  
  52. procedure TImportDlg.CancelBtnClick(Sender: TObject);
  53. begin
  54.   Close;
  55. end;
  56.  
  57. Procedure DBase2Isam(aParent: TForm;
  58.                      IsamTable: TIsamTable;
  59.                      DBASETableName: String;
  60.                      AliasName: String;
  61.                      FieldGet: DBASEImportProc);
  62. var AktDir: String;
  63. begin
  64.   if Pos('.',DBaseTableName) > 0 then DBaseTableName:= Copy(DBaseTableName,1,Pos('.',DBaseTableName)-1);
  65.   DBaseTableName:= DBaseTableName + '.DBF';
  66.   AktDir:= ExtractFilePath(Application.ExeName);
  67.   Check_Alias(AliasName,AktDir);
  68.   ImportDlg:= TImportDlg.Create(aParent);
  69.   Try
  70.     ImportDlg.IsamTable1:= IsamTable;
  71.     ImportDlg.Table1.DataBaseName:= AliasName;
  72.     ImportDlg.Table1.TableName:= DBaseTableName;
  73.     ImportDlg.FieldGetProc:= FieldGet;
  74.     ImportDlg.ShowModal;
  75.   Finally
  76.     ImportDlg.Free;
  77.   end;
  78. end;
  79.  
  80. procedure TImportDlg.FormDestroy(Sender: TObject);
  81. begin
  82.   FreeMem(Data,IsamTable1.RecSize);
  83.   FreeMem(Dup,IsamTable1.RecSize);
  84.   if Table1.Active then Table1.Close;
  85. end;
  86.  
  87. procedure TImportDlg.FormCreate(Sender: TObject);
  88. begin
  89.   FieldGetProc:= NIL;
  90.   if Sprache = 1 then begin
  91.     GroupBox1.Caption:= 'Options';
  92.     AktualRadio.Caption:= 'update only';
  93.     AppendRadio.Caption:= 'append new only';
  94.     AppendAndUpdateRadio.Caption:= 'append and update';
  95.     CancelBtn.Caption:= 'End';
  96.   end;
  97. end;
  98.  
  99. procedure TImportDlg.FormShow(Sender: TObject);
  100. begin
  101.   GetMem(Data,IsamTable1.RecSize);
  102.   GetMem(Dup,IsamTable1.RecSize);
  103.   Table1.Open;
  104. end;
  105.  
  106. procedure TImportDlg.StartBttnClick(Sender: TObject);
  107. var i,RCount: Longint;
  108.     Altprogress,NeuProgress: Integer;
  109.     Key1: IsamKeyStr;
  110. begin
  111.   if Table1.Active then begin
  112.     if IsamTable1.Active then begin
  113.       IsamTable1.KeyNo:= 1;
  114.       RCount:= Table1.RecordCount;
  115.       Table1.First;
  116.       i:= 0;
  117.       AltProgress:= 0;
  118.       IsamOk:= True;
  119.       Repeat
  120.         if IsamOk then begin
  121.           FieldGetProc(DATA^,Table1,IsamTable1);
  122.           Key1:= IsamTable1.Key_Proc(Data^,IsamTable1.KeyNo);
  123.           if IsamTable1.FindKey(Data^,Data^,Key1) then begin
  124.             if (AppendAndUpdateRadio.Checked) or (AktualRadio.Checked) then
  125.             IsamTable1.UpdateRecord(DATA^,DATA^);
  126.           end
  127.           else begin
  128.             if (AppendAndUpdateRadio.Checked) or (AppendRadio.Checked) then
  129.             IsamTable1.Append(DATA^,DATA^);
  130.           end;
  131.           Table1.Next;
  132.         end;
  133.         Inc(i);
  134.         NeuProgress:= Round((i/RCount)*100);
  135.         if AltProgress <> NeuProgress then begin
  136.           AltProgress:= NeuProgress;
  137.           Gauge1.Progress:= NeuProgress;
  138.         end;
  139.       Until (Table1.Eof) or (i = rCount);
  140.     end
  141.     else begin
  142.       if Sprache = 1 then Errorwindow('Isamtable is not opened','')
  143.       else Errorwindow('Isamtabelle ist nicht ge÷ffnet','');
  144.     end;
  145.   end
  146.   else begin
  147.     if Sprache = 1 then Errorwindow('Isamtable is not opened','')
  148.     else Errorwindow('DBASE-Tabelle ist nicht ge÷ffnet','');
  149.   end;
  150. end;
  151.  
  152. end.
  153.